Last updated: 2025-08-06

Checks: 6 1

Knit directory: Collaborations/

This reproducible R Markdown analysis was created with workflowr (version 1.7.1). The Checks tab describes the reproducibility checks that were applied when the results were created. The Past versions tab lists the development history.


The R Markdown file has unstaged changes. To know which version of the R Markdown file created these results, you’ll want to first commit it to the Git repo. If you’re still working on the analysis, you can ignore this warning. When you’re finished, you can run wflow_publish to commit the R Markdown file and build the HTML.

Great job! The global environment was empty. Objects defined in the global environment can affect the analysis in your R Markdown file in unknown ways. For reproduciblity it’s best to always run the code in an empty environment.

The command set.seed(20210523) was run prior to running the code in the R Markdown file. Setting a seed ensures that any results that rely on randomness, e.g. subsampling or permutations, are reproducible.

Great job! Recording the operating system, R version, and package versions is critical for reproducibility.

Nice! There were no cached chunks for this analysis, so you can be confident that you successfully produced the results during this run.

Great job! Using relative paths to the files within your workflowr project makes it easier to run your code on other machines.

Great! You are using Git for version control. Tracking code development and connecting the code version to the results is critical for reproducibility.

The results in this page were generated with repository version 5d069dc. See the Past versions tab to see a history of the changes made to the R Markdown and HTML files.

Note that you need to be careful to ensure that all relevant files for the analysis have been committed to Git prior to generating the results (you can use wflow_publish or wflow_git_commit). workflowr only checks the R Markdown file, but you know if there are other scripts or data files that it depends on. Below is the status of the Git repository when the results were generated:


Ignored files:
    Ignored:    .Rhistory
    Ignored:    analysis/.Rhistory
    Ignored:    analysis/2022_Mar2_Marinho_cache/

Unstaged changes:
    Modified:   analysis/2025_0601_Shikha.Rmd

Note that any generated files, e.g. HTML, png, CSS, etc., are not included in this status report because it is ok for generated content to have uncommitted changes.


These are the previous versions of the repository in which changes were made to the R Markdown (analysis/2025_0601_Shikha.Rmd) and HTML (docs/2025_0601_Shikha.html) files. If you’ve configured a remote Git repository (see ?wflow_git_remote), click on the hyperlinks in the table below to view the files as they were in that past version.

File Version Author Date Message
Rmd 5d069dc han 2025-08-06 8/6/2025
html 5d069dc han 2025-08-06 8/6/2025
Rmd d62c51e han 2025-07-28 7/28/2025
html d62c51e han 2025-07-28 7/28/2025
Rmd 48567d2 han 2025-07-28 7/28/2025
html 48567d2 han 2025-07-28 7/28/2025
Rmd e15351d han 2025-07-28 7/28/2025
html e15351d han 2025-07-28 7/28/2025
Rmd 6d54c64 han 2025-06-05 6/5/2025
html 6d54c64 han 2025-06-05 6/5/2025

data_raw=multiplesheets((file.path(root, "..\\2025\\202506\\Shikha\\Dr. Gupta Endo Data.xlsx")))
endo_cases=data_raw$EndoCases
endo_cases=endo_cases %>% mutate(tooth=paste0(endo_cases$Patient, ":", endo_cases$Site))

post_endo_tx=data_raw$`Post Endo TX`
post_endo_tx=post_endo_tx %>% mutate(tooth=paste0(post_endo_tx$Patient, ":", post_endo_tx$Site))

step 1: root canal

# Create a data frame
root_canal_codes <- data.frame(
  Code = c("D3310", "D3320", "D3330"),
  Description = c(
    "anterior RCT",
    "bicuspid RCT",
    "molar RCT"
  )
)

# Display table
knitr::kable(root_canal_codes, caption = "root canal Codes", align = 'lc')
root canal Codes
Code Description
D3310 anterior RCT
D3320 bicuspid RCT
D3330 molar RCT
endo_cases_with_root_canal=endo_cases %>% filter(Procedure %in% root_canal_codes$Code)
endo_cases_with_root_canal %>%
datatable(extensions = 'Buttons',
          caption = "", 
            options = list(dom = 'Blfrtip',
                           buttons = c('copy', 'csv', 'excel', 'pdf', 'print'),
                           lengthMenu = list(c(10,25,50,-1),
                                             c(10,25,50,"All"))))
# Count the number of each Procedure
procedure_counts <- endo_cases_with_root_canal %>%dplyr::count(Procedure)

# Bar plot
ggplot(procedure_counts, aes(x = Procedure, y = n, fill=Procedure)) +
  geom_bar(stat = "identity") +
  geom_text(aes(label = n), vjust = -0.5, size = 4) +
  labs(
    title = "",
    x = "Procedure Code",
    y = "Count"
  ) +
  theme_minimal() +
  theme(
    text = element_text(size = 14),
    plot.title = element_text(hjust = 0.5, face = "bold")
  )

Version Author Date
5d069dc han 2025-08-06

step 2: initial treatment

# Create a data frame of Final Restoration codes
final_restoration_codes <- data.frame(
  Code = c(
    "D2390", "D2391", "D2392", "D2393", "D2394",
    "D2650", "D2651", "D2652", "D2662", "D2663", "D2664",
    "D2710", "D2712", "D2720", "D2721", "D2722",
    "D2910", "D2915", "D2920", "D2932", "D2933",
    "D2940", "D2949", "D2950", "D2951", "D2952", "D2954",
    "D6068", "D6069", "D6070", "D6071", "D6072", "D6073", "D6074",
    "D6545", "D6548", "D6611",
    "D6710", "D6720", "D6721", "D6722",
    "D6740", "D6750", "D6780", "D6790", "D6793",
    "D6930", "D6971"
  ),
  Description = c(
    "Resin-based comp crown, ant.",
    "Resin-based comp - 1 surface, posterior",
    "Resin-based comp - 2 surfaces, posterior",
    "Resin-based comp - 3 surfaces, posterior",
    "Resin-based comp - 4+ surfaces, posterior",
    "Inlay - resin - 1 surface",
    "Inlay - resin - 2 surfaces",
    "Inlay - resin - 3 or more",
    "Onlay - resin - 2 surfaces",
    "Onlay - resin - 3 surfaces",
    "Onlay - resin - 4 or more",
    "Resin crown - laboratory",
    "Crown - 3/4 resin-based comp",
    "Resin crown - high noble metal",
    "Resin crown - predominately base metal",
    "Resin crown - noble metal",
    "Recement/re-bond inlay/onlay",
    "Recement cast or prefab post",
    "Recement/re-bond crown",
    "Prefabricated resin crown",
    "Prefab stainless steel crown w/ resin window",
    "Protective restoration",
    "Restorative foundation/indirect restoration",
    "Core buildup - including pins",
    "Pin retention - per tooth",
    "Post & core, indirect fabrication",
    "Prefab post and core",
    "Abutment-retainer, porcelain/ceramic FPD",
    "Abutment-ret., PFM FPD, high noble",
    "Abutment-ret., PFM FPD, base metal",
    "Abutment-ret., PFM FPD, noble metal",
    "Abut-ret., cast metal, high noble",
    "Abut-ret., cast metal, base metal",
    "Abut-ret., cast metal, noble metal",
    "Retainer, metal, resin-bonded FPD",
    "Retainer, porcelain/ceramic, bonded FPD",
    "Retainer onlay, high noble metal, 3+ surfaces",
    "Crown - indirect resin-based",
    "Crown - resin, high noble metal",
    "Crown - resin, predominately base metal",
    "Crown - resin, noble metal",
    "Retainer crown - porcelain/ceramic",
    "Retainer crown - porcelain fused to high noble metal",
    "Retainer crown - 3/4 cast, high noble metal",
    "Retainer crown - full cast, high noble metal",
    "Provisional retainer crown",
    "Recement/re-bond FPD",
    "Cast post - part of FPD retainer"
  )
)

knitr::kable(final_restoration_codes, caption = "final restoration codes", align = 'lc')
final restoration codes
Code Description
D2390 Resin-based comp crown, ant.
D2391 Resin-based comp - 1 surface, posterior
D2392 Resin-based comp - 2 surfaces, posterior
D2393 Resin-based comp - 3 surfaces, posterior
D2394 Resin-based comp - 4+ surfaces, posterior
D2650 Inlay - resin - 1 surface
D2651 Inlay - resin - 2 surfaces
D2652 Inlay - resin - 3 or more
D2662 Onlay - resin - 2 surfaces
D2663 Onlay - resin - 3 surfaces
D2664 Onlay - resin - 4 or more
D2710 Resin crown - laboratory
D2712 Crown - 3/4 resin-based comp
D2720 Resin crown - high noble metal
D2721 Resin crown - predominately base metal
D2722 Resin crown - noble metal
D2910 Recement/re-bond inlay/onlay
D2915 Recement cast or prefab post
D2920 Recement/re-bond crown
D2932 Prefabricated resin crown
D2933 Prefab stainless steel crown w/ resin window
D2940 Protective restoration
D2949 Restorative foundation/indirect restoration
D2950 Core buildup - including pins
D2951 Pin retention - per tooth
D2952 Post & core, indirect fabrication
D2954 Prefab post and core
D6068 Abutment-retainer, porcelain/ceramic FPD
D6069 Abutment-ret., PFM FPD, high noble
D6070 Abutment-ret., PFM FPD, base metal
D6071 Abutment-ret., PFM FPD, noble metal
D6072 Abut-ret., cast metal, high noble
D6073 Abut-ret., cast metal, base metal
D6074 Abut-ret., cast metal, noble metal
D6545 Retainer, metal, resin-bonded FPD
D6548 Retainer, porcelain/ceramic, bonded FPD
D6611 Retainer onlay, high noble metal, 3+ surfaces
D6710 Crown - indirect resin-based
D6720 Crown - resin, high noble metal
D6721 Crown - resin, predominately base metal
D6722 Crown - resin, noble metal
D6740 Retainer crown - porcelain/ceramic
D6750 Retainer crown - porcelain fused to high noble metal
D6780 Retainer crown - 3/4 cast, high noble metal
D6790 Retainer crown - full cast, high noble metal
D6793 Provisional retainer crown
D6930 Recement/re-bond FPD
D6971 Cast post - part of FPD retainer
post_endo_tx_with_final_restoration_codes=post_endo_tx %>% filter(Procedure %in% final_restoration_codes$Code )

time period between root canal and inital treatment

library(dplyr)
library(DT)

# Ensure date columns are Date type
endo_cases_with_root_canal$Date <- as.Date(endo_cases_with_root_canal$Date)
post_endo_tx_with_final_restoration_codes$Date <- as.Date(post_endo_tx_with_final_restoration_codes$Date)

# Step 1: Get the first restoration date + procedure per tooth
first_restoration <- post_endo_tx_with_final_restoration_codes %>%
  group_by(tooth) %>%
  filter(Date == min(Date)) %>%
  slice(1) %>%  # In case there are ties
  ungroup() %>%
  select(tooth, first_restoration_date = Date, first_restoration_procedure = Procedure)

# Step 2: Join back with the root canal data
endo_with_tx_time <- endo_cases_with_root_canal %>%
  left_join(first_restoration, by = "tooth") %>%
  filter(!is.na(first_restoration_date)) %>%  # Remove if no restoration found
  mutate(
    time_between_days = as.numeric(first_restoration_date - Date)
  ) %>%
  select(
    Patient,
    tooth,
    Date,
    root_canal_procedure = Procedure,
    first_restoration_date,
    first_restoration_procedure,
    time_between_days
  )

# Step 3: Render as datatable
endo_with_tx_time %>%
  datatable(
    extensions = 'Buttons',
    caption = "",
    options = list(
      dom = 'Blfrtip',
      buttons = c('copy', 'csv', 'excel', 'pdf', 'print'),
      lengthMenu = list(c(10, 25, 50, -1), c(10, 25, 50, "All"))
    )
  )
library(dplyr)
library(lubridate)

# Ensure Date columns are Date type
endo_cases_with_root_canal$Date <- as.Date(endo_cases_with_root_canal$Date)
post_endo_tx_with_final_restoration_codes$Date <- as.Date(post_endo_tx_with_final_restoration_codes$Date)

# Rename for clarity
endo <- endo_cases_with_root_canal %>%
  rename(endo_date = Date,
         endo_procedure = Procedure)

resto <- post_endo_tx_with_final_restoration_codes %>%
  rename(restoration_date = Date,
         restoration_procedure = Procedure)

# Perform many-to-many join by "tooth"
combined <- inner_join(endo, resto, by = "tooth") %>%
  # Optional: restrict to matching Patient as well
  filter(Patient.x == Patient.y) %>%
  mutate(time_between_days = as.numeric(restoration_date - endo_date)) %>%
  select(
    Patient = Patient.x,
    tooth,
    endo_date,
    endo_procedure,
    restoration_date,
    restoration_procedure,
    time_between_days
  ) %>%
  arrange(Patient, tooth, endo_date, restoration_date)

# View results

combined %>%
  datatable(
    extensions = 'Buttons',
    caption = "",
    options = list(
      dom = 'Blfrtip',
      buttons = c('copy', 'csv', 'excel', 'pdf', 'print'),
      lengthMenu = list(c(10, 25, 50, -1), c(10, 25, 50, "All"))
    )
  )

step 3: post treatment

# Create a data frame
failure_codes <- data.frame(
  Code = c("D3346", "D3347", "D3348", "D3421", "D3425", "D3410", "D3426",
           "D3430", "D3450", "D3470", "D3505", "D3920", "D7140", "D7210"),
  Description = c(
    "Anterior-retreat prev. rt. canal",
    "Bicuspid retreat prev. rt. canal",
    "Molar retreat prev. rt. canal",
    "Apicoectomy - bicuspid (1st root)",
    "Apicoectomy - molar (1st root)",
    "Apicoectomy - anterior",
    "Apicoectomy - additional roots",
    "Retrograde filling - per root",
    "Root amputation - per root",
    "Intentional reimplantation",
    "Surgical exposure of root surface w/o apicoectomy",
    "Hemisection, incl. root removal",
    "Extraction",
    "Surgical removal of erupted tooth"
  )
)

# Display table
knitr::kable(failure_codes, caption = "Failure-related Procedure Codes", align = 'lc')
Failure-related Procedure Codes
Code Description
D3346 Anterior-retreat prev. rt. canal
D3347 Bicuspid retreat prev. rt. canal
D3348 Molar retreat prev. rt. canal
D3421 Apicoectomy - bicuspid (1st root)
D3425 Apicoectomy - molar (1st root)
D3410 Apicoectomy - anterior
D3426 Apicoectomy - additional roots
D3430 Retrograde filling - per root
D3450 Root amputation - per root
D3470 Intentional reimplantation
D3505 Surgical exposure of root surface w/o apicoectomy
D3920 Hemisection, incl. root removal
D7140 Extraction
D7210 Surgical removal of erupted tooth

basic numbers and data structure

endo_cases_updated=endo_cases %>% mutate(tooth=paste0(endo_cases$Patient, ":", endo_cases$Site))
post_endo_tx_updated=post_endo_tx %>% mutate(tooth=paste0(post_endo_tx$Patient, ":", post_endo_tx$Site))
post_endo_tx_updated=post_endo_tx_updated %>% filter(`Endo Check`=="Yes")

head(endo_cases_updated)
  Patient      Birth Sex Site Procedure Producer       Date  tooth
1      85 1985-10-17   1    8     D3310     S941 2004-03-18   85:8
2     173 1995-04-27   2    7     D3310    S2575 2015-05-21  173:7
3     173 1995-04-27   2    7     D3310    S2575 2015-04-24  173:7
4     182 1995-11-08   2   18     D3330    G2362 2012-06-20 182:18
5     182 1995-11-08   2   31     D3330    G2362 2012-06-25 182:31
6     182 1995-11-08   2   18     D3330    G2362 2012-06-19 182:18
dim(endo_cases_updated)
[1] 45119     8
head(post_endo_tx_updated)
  Patient Producer Site       Date Endo Check Procedure  tooth
1      85     S941    8 2004-03-18        Yes     D3310   85:8
2     173     S932   14 2004-11-29        Yes     D2391 173:14
3     173    FPEDO    J 2004-11-22        Yes     D2920  173:J
4     173    S1051   19 2005-02-28        Yes     D2391 173:19
5     173    S1051   30 2005-02-28        Yes     D2391 173:30
6     173    S2575    7 2015-05-21        Yes     D3310  173:7
dim(post_endo_tx_updated)
[1] 192958      7
library(dplyr)
library(lubridate)

# Define failure codes
failure_codes <- c(
  "D3346", "D3347", "D3348", "D3421", "D3425", "D3410", "D3426",
  "D3430", "D3450", "D3470", "D3505", "D3920", "D7140", "D7210"
)

# 1. Ensure dates are Date type
endo_cases_updated <- endo_cases_updated %>%
  mutate(Date = as.Date(Date))

post_endo_tx_updated <- post_endo_tx_updated %>%
  mutate(Date = as.Date(Date))

# 2. Get earliest treatment date per tooth
treatment_start <- endo_cases_updated %>%
  group_by(tooth) %>%
  summarise(start_date = min(Date), .groups = "drop")

# 3. Get first failure date (if any)
failure_info <- post_endo_tx_updated %>%
  filter(Procedure %in% failure_codes) %>%
  group_by(tooth) %>%
  summarise(failure_date = min(Date), .groups = "drop")

# 4. Get last follow-up date for censoring
last_followup <- post_endo_tx_updated %>%
  group_by(tooth) %>%
  summarise(last_date = max(Date), .groups = "drop")

# 5. Merge everything
survival_data <- treatment_start %>%
  left_join(failure_info, by = "tooth") %>%
  left_join(last_followup, by = "tooth") %>%
  mutate(
    event_date = if_else(!is.na(failure_date), failure_date, last_date),
    status = if_else(!is.na(failure_date), 1, 0),  # 1 = failure, 0 = censored
    survival_days = as.numeric(difftime(event_date, start_date, units = "days"))
  )

# View result

survival data

survival_data=survival_data%>% filter(survival_days>0)
survival_data%>%
datatable(extensions = 'Buttons',
          caption = "", 
            options = list(dom = 'Blfrtip',
                           buttons = c('copy', 'csv', 'excel', 'pdf', 'print'),
                           lengthMenu = list(c(10,25,50,-1),
                                             c(10,25,50,"All"))))

survival analysis

library(survival)
library(survminer)

km_fit <- survfit(Surv(survival_days, status) ~ 1, data = survival_data)


# Plot KM survival curve
ggsurvplot(
  km_fit,
  data = survival_data,
  risk.table = TRUE,        # Show number at risk below the plot
  pval = TRUE,              # Show p-value (for comparison if groups exist)
  conf.int = TRUE,          # Show confidence interval
  xlab = "Days Since Treatment",
  ylab = "Tooth Survival Probability",
  title = "Kaplan-Meier Survival Estimate for Endodontic Treatment",
  surv.median.line = "hv",  # Add horizontal/vertical median survival line
  theme = theme_minimal()
)

Version Author Date
5d069dc han 2025-08-06

sessionInfo()
R version 4.3.2 (2023-10-31 ucrt)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 11 x64 (build 26100)

Matrix products: default


locale:
[1] LC_COLLATE=English_United States.utf8 
[2] LC_CTYPE=English_United States.utf8   
[3] LC_MONETARY=English_United States.utf8
[4] LC_NUMERIC=C                          
[5] LC_TIME=English_United States.utf8    

time zone: America/Chicago
tzcode source: internal

attached base packages:
[1] grid      stats     graphics  grDevices utils     datasets  methods  
[8] base     

other attached packages:
 [1] survminer_0.5.0     survival_3.8-3      VennDiagram_1.7.3  
 [4] futile.logger_1.4.3 condsurv_1.0.0      devtools_2.4.5     
 [7] usethis_3.1.0       tidycmprsk_1.1.0    gtsummary_2.0.4    
[10] ggsurvfit_1.1.0     irr_0.84.1          lpSolve_5.6.23     
[13] readxl_1.4.3        cowplot_1.1.3       matrixStats_1.5.0  
[16] gridExtra_2.3       DT_0.33             rstatix_0.7.2      
[19] ggpubr_0.6.0        kableExtra_1.4.0    lubridate_1.9.4    
[22] forcats_1.0.0       stringr_1.5.1       dplyr_1.1.4        
[25] purrr_1.0.2         readr_2.1.4         tidyr_1.3.1        
[28] tibble_3.2.1        ggplot2_3.5.1       tidyverse_2.0.0    
[31] rprojroot_2.0.4    

loaded via a namespace (and not attached):
 [1] formatR_1.14         remotes_2.5.0        rlang_1.1.2         
 [4] magrittr_2.0.3       git2r_0.35.0         compiler_4.3.2      
 [7] systemfonts_1.2.1    vctrs_0.6.5          profvis_0.4.0       
[10] pkgconfig_2.0.3      fastmap_1.2.0        backports_1.5.0     
[13] ellipsis_0.3.2       labeling_0.4.3       KMsurv_0.1-5        
[16] promises_1.3.2       rmarkdown_2.29       markdown_1.13       
[19] sessioninfo_1.2.2    tzdb_0.4.0           xfun_0.50.6         
[22] cachem_1.1.0         jsonlite_1.8.9       later_1.4.1         
[25] broom_1.0.7          R6_2.5.1             bslib_0.9.0         
[28] stringi_1.8.3        car_3.1-3            pkgload_1.4.0       
[31] jquerylib_0.1.4      cellranger_1.1.0     Rcpp_1.0.11         
[34] knitr_1.49           zoo_1.8-14           httpuv_1.6.15       
[37] Matrix_1.6-1.1       splines_4.3.2        timechange_0.3.0    
[40] tidyselect_1.2.1     rstudioapi_0.17.1    abind_1.4-8         
[43] yaml_2.3.8           ggtext_0.1.2         miniUI_0.1.1.1      
[46] pkgbuild_1.4.6       lattice_0.21-9       shiny_1.10.0        
[49] withr_3.0.2          evaluate_1.0.3       lambda.r_1.2.4      
[52] urlchecker_1.0.1     xml2_1.3.6           survMisc_0.5.6      
[55] pillar_1.10.1        carData_3.0-5        whisker_0.4.1       
[58] generics_0.1.3       hms_1.1.3            commonmark_1.9.2    
[61] munsell_0.5.1        scales_1.3.0         xtable_1.8-4        
[64] glue_1.8.0           tools_4.3.2          data.table_1.16.4   
[67] ggsignif_0.6.4       fs_1.6.5             crosstalk_1.2.1     
[70] colorspace_2.1-0     Formula_1.2-5        cli_3.6.2           
[73] km.ci_0.5-6          workflowr_1.7.1      futile.options_1.0.1
[76] viridisLite_0.4.2    svglite_2.1.3        gtable_0.3.6        
[79] sass_0.4.9           digest_0.6.33        farver_2.1.2        
[82] htmlwidgets_1.6.4    memoise_2.0.1        htmltools_0.5.8.1   
[85] lifecycle_1.0.4      mime_0.12            gridtext_0.1.5